Analyzing Business Relations & Documents

class: title-slide

# ER018 - Analyzing Business Relations & Documents

## PVA3

### Soziale Netzwerkanalyse

<br>
<br>
<br>
<br>
<br>
<br>
<br>
### FS 2024
<br>
### Prof. Dr. Jörg Schoder
.mycontacts[
<svg aria-hidden="true" role="img" viewBox="0 0 496 512" style="height:1em;width:0.97em;vertical-align:-0.125em;margin-left:auto;margin-right:auto;font-size:inherit;fill:currentColor;overflow:visible;position:relative;"><path d="M165.9 397.4c0 2-2.3 3.6-5.2 3.6-3.3.3-5.6-1.3-5.6-3.6 0-2 2.3-3.6 5.2-3.6 3-.3 5.6 1.3 5.6 3.6zm-31.1-4.5c-.7 2 1.3 4.3 4.3 4.9 2.6 1 5.6 0 6.2-2s-1.3-4.3-4.3-5.2c-2.6-.7-5.5.3-6.2 2.3zm44.2-1.7c-2.9.7-4.9 2.6-4.6 4.9.3 2 2.9 3.3 5.9 2.6 2.9-.7 4.9-2.6 4.6-4.6-.3-1.9-3-3.2-5.9-2.9zM244.8 8C106.1 8 0 113.3 0 252c0 110.9 69.8 205.8 169.5 239.2 12.8 2.3 17.3-5.6 17.3-12.1 0-6.2-.3-40.4-.3-61.4 0 0-70 15-84.7-29.8 0 0-11.4-29.1-27.8-36.6 0 0-22.9-15.7 1.6-15.4 0 0 24.9 2 38.6 25.8 21.9 38.6 58.6 27.5 72.9 20.9 2.3-16 8.8-27.1 16-33.7-55.9-6.2-112.3-14.3-112.3-110.5 0-27.5 7.6-41.3 23.6-58.9-2.6-6.5-11.1-33.3 2.6-67.9 20.9-6.5 69 27 69 27 20-5.6 41.5-8.5 62.8-8.5s42.8 2.9 62.8 8.5c0 0 48.1-33.6 69-27 13.7 34.7 5.2 61.4 2.6 67.9 16 17.7 25.8 31.5 25.8 58.9 0 96.5-58.9 104.2-114.8 110.5 9.2 7.9 17 22.9 17 46.4 0 33.7-.3 75.4-.3 83.6 0 6.5 4.6 14.4 17.3 12.1C428.2 457.8 496 362.9 496 252 496 113.3 383.5 8 244.8 8zM97.2 352.9c-1.3 1-1 3.3.7 5.2 1.6 1.6 3.9 2.3 5.2 1 1.3-1 1-3.3-.7-5.2-1.6-1.6-3.9-2.3-5.2-1zm-10.8-8.1c-.7 1.3.3 2.9 2.3 3.9 1.6 1 3.6.7 4.3-.7.7-1.3-.3-2.9-2.3-3.9-2-.6-3.6-.3-4.3.7zm32.4 35.6c-1.6 1.3-1 4.3 1.3 6.2 2.3 2.3 5.2 2.6 6.5 1 1.3-1.3.7-4.3-1.3-6.2-2.2-2.3-5.2-2.6-6.5-1zm-11.4-14.7c-1.6 1-1.6 3.6 0 5.9 1.6 2.3 4.3 3.3 5.6 2.3 1.6-1.3 1.6-3.9 0-6.2-1.4-2.3-4-3.3-5.6-2z"/></svg> @FFHS-EconomicResearch
<svg aria-hidden="true" role="img" viewBox="0 0 448 512" style="height:1em;width:0.88em;vertical-align:-0.125em;margin-left:auto;margin-right:auto;font-size:inherit;fill:currentColor;overflow:visible;position:relative;"><path d="M416 32H31.9C14.3 32 0 46.5 0 64.3v383.4C0 465.5 14.3 480 31.9 480H416c17.6 0 32-14.5 32-32.3V64.3c0-17.8-14.4-32.3-32-32.3zM135.4 416H69V202.2h66.5V416zm-33.2-243c-21.3 0-38.5-17.3-38.5-38.5S80.9 96 102.2 96c21.2 0 38.5 17.3 38.5 38.5 0 21.3-17.2 38.5-38.5 38.5zm282.1 243h-66.4V312c0-24.8-.5-56.7-34.5-56.7-34.6 0-39.9 27-39.9 54.9V416h-66.4V202.2h63.7v29.2h.9c8.9-16.8 30.6-34.5 62.9-34.5 67.2 0 79.7 44.3 79.7 101.9V416z"/></svg> @jfschoder
]

---
layout: true

<div style="position: absolute;left:400px;bottom:10px;font-size:9px"><svg aria-hidden="true" role="img" viewBox="0 0 496 512" style="height:1em;width:0.97em;vertical-align:-0.125em;margin-left:auto;margin-right:auto;font-size:inherit;fill:currentColor;overflow:visible;position:relative;"><path d="M245.83 214.87l-33.22 17.28c-9.43-19.58-25.24-19.93-27.46-19.93-22.13 0-33.22 14.61-33.22 43.84 0 23.57 9.21 43.84 33.22 43.84 14.47 0 24.65-7.09 30.57-21.26l30.55 15.5c-6.17 11.51-25.69 38.98-65.1 38.98-22.6 0-73.96-10.32-73.96-77.05 0-58.69 43-77.06 72.63-77.06 30.72-.01 52.7 11.95 65.99 35.86zm143.05 0l-32.78 17.28c-9.5-19.77-25.72-19.93-27.9-19.93-22.14 0-33.22 14.61-33.22 43.84 0 23.55 9.23 43.84 33.22 43.84 14.45 0 24.65-7.09 30.54-21.26l31 15.5c-2.1 3.75-21.39 38.98-65.09 38.98-22.69 0-73.96-9.87-73.96-77.05 0-58.67 42.97-77.06 72.63-77.06 30.71-.01 52.58 11.95 65.56 35.86zM247.56 8.05C104.74 8.05 0 123.11 0 256.05c0 138.49 113.6 248 247.56 248 129.93 0 248.44-100.87 248.44-248 0-137.87-106.62-248-248.44-248zm.87 450.81c-112.54 0-203.7-93.04-203.7-202.81 0-105.42 85.43-203.27 203.72-203.27 112.53 0 202.82 89.46 202.82 203.26-.01 121.69-99.68 202.82-202.84 202.82z"/></svg>Prof. Dr. Jörg Schoder</div>

---
name: agenda
class: left

.blockquote[Agenda]

## Einführung in die Netzwerkanalayse

* Netzwerkdaten erzeugen und importieren

* Netzwerkdaten visualisieren

* Vermessung von Netzwerken

---
class: inverse, center, middle

## Netzwerkdaten erzeugen und importieren

.blockquote[Elementare Netzwerkdaten]

.blockquote[Netzwerkobjekte erzeugen]

.blockquote[Netzwerkdaten importieren]

.blockquote[Netzwerkdaten transformieren]

---
class: left

.blockquote[Elementare Netzwerkdaten]

## Akteure, Beziehungen und Eigenschaften

* Knoten (mit Eigenschaften):

```r
library(tidyverse)
#most popular babynames in CH 2022
actors <- tibble(name=c("Emma","Mia","Sofia","Noah","Liam","Matteo"),
                 sex=c("weiblich","weiblich","weiblich","männlich","männlich","männlich"))
```

* Kanten (mit Eigenschaften):

```r
ties <- tibble(from=c("Noah","Noah","Noah","Noah","Noah"),
                to=c("Emma","Mia","Sofia","Liam","Matteo"),
                type=c("Partnerin","Kollegin","Kollegin","Freund","Freund"),
               interaction=c(7,2,3,5,2))
```

---
class: left

.blockquote[Knoten und Kanten]

## Aufgabe: Erzeuge Knoten und Kanten zum dargestellten Graphen:

![](data:image/png;base64,#02_tidyNA_files/figure-html/unnamed-chunk-3-1.png)

---
class: left

.blockquote[Netzwerkobjekte erzeugen]

## Netzwerkobjekte mit igraph und tidygraph

* igraph-Objekt erzeugen

```r
library(igraph) # Paket laden
ig <- graph_from_data_frame(ties, directed=FALSE, vertices=actors)
class(ig)
```

```
## [1] "igraph"
```

* `tbl_graph()`-Objekt erzeugen

```r
library(tidygraph) # Paket laden
tg <- tbl_graph(nodes = actors, edges = ties, directed = FALSE)
```

---
class: left

.blockquote[Netzwerkdaten importieren]

## Beispiel: Daten "Hochzeitsmarkt Florenz"

* Daten im **network**-Paket enthalten

```r
library(network) # ggf. Paket installieren
data(flo)
net_flo <- graph_from_adjacency_matrix(flo)
tidy_flo <- as_tbl_graph(net_flo)
```

---
class: left

.blockquote[Netzwerkdaten importieren]

## Beispiel: Datensatz "Media"-Example importieren

* Knoten importieren

```r
my_in_file <- "Dataset1-Media-Example-NODES.csv"
nodes <- readr::read_csv(xfun::from_root("data","raw","PVA2",my_in_file))
```

* Aufgabe: Kanten importieren:

* Download-Links für die Datensätze:
  * [Knoten](https://github.com/FFHS-EconomicResearch/ER018/blob/main/data/raw/PVA2/Dataset1-Media-Example-NODES.csv)
  * [Kanten](https://github.com/FFHS-EconomicResearch/ER018/blob/main/data/raw/PVA2/Dataset1-Media-Example-EDGES.csv)

---
class: left

.blockquote[Netzwerkdaten transformieren]

## Beispiel: Florentinische Familien

.panelset[
.panel[.panel-name[Transformation]
* Nützliche **tidygraph**-Funktionen
  * `activate()`
  * `.E()`, `.N()`

* Beispiel: Hinzufügen der Eigenschaft "direkter Zugang zu den Medici"

```r
flo_tidy <- tidy_flo %>% 
              activate("edges") %>%  # Kanten aktivieren
              mutate(to_medici=(.N()$name[from]=="Medici" |
                                .N()$name[to]=="Medici"))
```
]
.panel[.panel-name[Vorher]

```r
tidy_flo
```

```
## # A tbl_graph: 16 nodes and 40 edges
## #
## # A directed simple graph with 2 components
## #
## # A tibble: 16 × 1
##   name      
##   <chr>     
## 1 Acciaiuoli
## 2 Albizzi   
## 3 Barbadori 
## 4 Bischeri  
## 5 Castellani
## 6 Ginori    
## # ℹ 10 more rows
## #
## # A tibble: 40 × 2
##    from    to
##   <int> <int>
## 1     1     9
## 2     2     6
## 3     2     7
## # ℹ 37 more rows
```
]
.panel[.panel-name[Vorher]

```r
flo_tidy
```

```
## # A tbl_graph: 16 nodes and 40 edges
## #
## # A directed simple graph with 2 components
## #
## # A tibble: 40 × 3
##    from    to to_medici
##   <int> <int> <lgl>    
## 1     1     9 TRUE     
## 2     2     6 FALSE    
## 3     2     7 FALSE    
## 4     2     9 TRUE     
## 5     3     5 FALSE    
## 6     3     9 TRUE     
## # ℹ 34 more rows
## #
## # A tibble: 16 × 1
##   name      
##   <chr>     
## 1 Acciaiuoli
## 2 Albizzi   
## 3 Barbadori 
## # ℹ 13 more rows
```
]
]

---
class: left

.blockquote[Netzwerkdaten transformieren]

## Teilgruppen (Subgraph) extrahieren

```r
medici_sub <- flo_tidy %>% 
  activate("edges") %>% 
  filter(to_medici)
```

---
class: inverse, center, middle

## Netzwerkdaten visualisieren

.blockquote[Einfache plots mit igraph]

.blockquote[Flexible plots mit ggraph]

???

* ToDo Interaktive Plots mit visNetwork

---
class: left

.blockquote[Plots mit igraph]

## Vom Netzwerkobjekt zum Graphen

```r
plot(ig)
```

---
class: left

.blockquote[Flexible Plots mit ggraph]

## Vom Netzwerkobjekt zum Graphen

```r
library(ggraph)
tg %>% ggraph(layout = "graphopt") + 
            geom_node_point(size=7,color=FFHSred) +
            geom_node_text(aes(label = name,color=FFHSpurp), 
                           vjust=1.55,hjust=1.2,show.legend = FALSE) +
            geom_edge_link(color=FFHSpurp,width=1.1,
                          start_cap = ggraph::circle(3,'mm'),
                          end_cap = ggraph::circle(3,'mm')) +
            theme_void()
```

---
class: left

.blockquote[Flexible Plots mit ggraph]

## Aufgabe: Medici-Netzwerk

.content-box-purple[
.white[
Erzeuge einen Graphen zum Medici-Netzwerk. Die Kanten von Familien mit "direktem Zugang" zu den Medici sollen dabei hervorgehoben werden.]
]

![](data:image/png;base64,#02_tidyNA_files/figure-html/unnamed-chunk-15-1.png)

???

geom_edge_link0(aes(edge_color = to_medici))+

---
class: inverse, center, middle

## Vermessung von Netzwerken

.blockquote[Zentralität]

.blockquote[Dichte]

.blockquote[Pfade und Distanzen]

.blockquote[Verbundenheit]

.blockquote[Clustering]

???

Gliederung nach Barabasi (2016)

---
class:

.blockquote[Zentralität]

## Beispiel: Freundschaftsnetzwerk

* `activate()`

```r
tg %>% 
    activate(nodes) %>% 
    mutate(degree = centrality_degree()) 
```

```
## # A tbl_graph: 6 nodes and 5 edges
## #
## # An unrooted tree
## #
## # A tibble: 6 × 3
##   name   sex      degree
##   <chr>  <chr>     <dbl>
## 1 Emma   weiblich      1
## 2 Mia    weiblich      1
## 3 Sofia  weiblich      1
## 4 Noah   männlich      5
## 5 Liam   männlich      1
## 6 Matteo männlich      1
## #
## # A tibble: 5 × 4
##    from    to type      interaction
##   <int> <int> <chr>           <dbl>
## 1     1     4 Partnerin           7
## 2     2     4 Kollegin            2
## 3     3     4 Kollegin            3
## # ℹ 2 more rows
```

```r
tg %>%  activate(edges) %>% 
    mutate(betweenness = centrality_edge_betweenness(), 
         # .N() gets the nodes data from edge you're accessing
         homo = (.N()$sex[from] == .N()$sex[to]))
```

```
## # A tbl_graph: 6 nodes and 5 edges
## #
## # An unrooted tree
## #
## # A tibble: 5 × 6
##    from    to type      interaction betweenness homo 
##   <int> <int> <chr>           <dbl>       <dbl> <lgl>
## 1     1     4 Partnerin           7           5 FALSE
## 2     2     4 Kollegin            2           5 FALSE
## 3     3     4 Kollegin            3           5 FALSE
## 4     4     5 Freund              5           5 TRUE 
## 5     4     6 Freund              2           5 TRUE 
## #
## # A tibble: 6 × 2
##   name  sex     
##   <chr> <chr>   
## 1 Emma  weiblich
## 2 Mia   weiblich
## 3 Sofia weiblich
## # ℹ 3 more rows
```

---
class: left

.blockquote[Zentralität]

## Beispiel: Florentinische Familien

.content-box-purple[
.white[
Ermittle zwei Zentralitätsmaße für das florentinische Familiennetzwerk.]
]

```
## # A tbl_graph: 16 nodes and 40 edges
## #
## # A directed simple graph with 2 components
## #
## # A tibble: 16 × 3
##   name       degree betweenness
##   <chr>       <dbl>       <dbl>
## 1 Acciaiuoli      1         0  
## 2 Albizzi         3        38.7
## 3 Barbadori       2        17  
## 4 Bischeri        3        19  
## 5 Castellani      3        10  
## 6 Ginori          1         0  
## # ℹ 10 more rows
## #
## # A tibble: 40 × 3
##    from    to to_medici
##   <int> <int> <lgl>    
## 1     1     9 TRUE     
## 2     2     6 FALSE    
## 3     2     7 FALSE    
## # ℹ 37 more rows
```

---
class: left

.blockquote[Zentralität]

## Grafische Darstellung der Zentralität am Beispiel "Medici"

![](data:image/png;base64,#02_tidyNA_files/figure-html/unnamed-chunk-18-1.png)

---
class: left

.blockquote[Pfade und Distanzen]

## Durchmesser

```r
tg  %>%
 mutate(Diameter = graph_diameter())
```

```
## # A tbl_graph: 6 nodes and 5 edges
## #
## # An unrooted tree
## #
## # A tibble: 6 × 3
##   name   sex      Diameter
##   <chr>  <chr>       <dbl>
## 1 Emma   weiblich        2
## 2 Mia    weiblich        2
## 3 Sofia  weiblich        2
## 4 Noah   männlich        2
## 5 Liam   männlich        2
## 6 Matteo männlich        2
## #
## # A tibble: 5 × 4
##    from    to type      interaction
##   <int> <int> <chr>           <dbl>
## 1     1     4 Partnerin           7
## 2     2     4 Kollegin            2
## 3     3     4 Kollegin            3
## # ℹ 2 more rows
```

---
class: left

.blockquote[Clustering]

## Beispiel mit Zufallsdaten

```r
# create random graph with group structure (igraph equivalent is sample_islands())
play_islands(4, 12, 0.8, 4) %>% 
  mutate(community = as.factor(group_louvain())) %>% 
  activate("edges") %>% 
  mutate(community = as.factor(ifelse(.N()$community[from]==.N()$community[to],.N()$community[from],5))) %>% 
  ggraph(layout = 'stress') + 
  geom_edge_link0(aes(edge_colour=community),show.legend = FALSE) + 
  geom_node_point(aes(fill = community), shape = 21, size = 6) + 
  scale_fill_brewer(palette = "Set3")+
  scale_edge_color_brewer(palette = "Set3")+
  theme_graph(background = "grey88")
```

![](data:image/png;base64,#02_tidyNA_files/figure-html/unnamed-chunk-20-1.png)

???

* Fokus auf einer Entität bzw. einem Knoten ("Ego")

---
class: inverse,center,middle

# Wir brauchen eine Pause.

---

background-image: url("data:image/png;base64,#http://bit.ly/cs631-donkey")
background-size: 80%

---
class: left

## Quellenverzeichnis

.ref-slide[

```
## You haven't cited any references in this bibliography yet.
```

NULL
]